C
C
	CHARACTER*1 MRK(8)
	CHARACTER*2 IY,PND(8),TT,PCDA
	CHARACTER*3 P1(50),P2(50),MON(12),PMN
	CHARACTER*4 IYT
	CHARACTER*5 CBTT(50),CBTK(50),CBB(50),CBT(50)
	CHARACTER*6 N
	CHARACTER*7 P,TPER(50),PER(50)
	CHARACTER*8 U,F,ANS,A
	CHARACTER*9 PC(5),PCD(50),PCE(50),PA(8)
	CHARACTER*10 S,C
	CHARACTER*11 MONT(12),MONTH
	CHARACTER*12 MARK
	CHARACTER*20 FT(50),TIT(50)
	CHARACTER*25 ADD
	CHARACTER*27 AP
C
	DIMENSION FN(50),FH(50),IFN(50),IFH(50),IFL(50),AVE(50),AV(12)
	DIMENSION MN(12),DATA(12),FL(50),FP(50),IAVE(50),IPN(50),AREA(50)
	DIMENSION IPH(50),IPL(50),JAVE(50),ISRT(50),IFP(50),ISRR(50)
	DIMENSION DAVE(50)
C
C
	INCLUDE 'DRA2:[MPOLL]OPEN.MP/LIST'
C       INCLUDE 'SYS$LIBRARY:FORSYSDEF.TLB($FORIOSDEF)/LIST'
C
C
	DATA MON/'OCT','NOV','DEC','JAN','FEB','MAR','APR','MAY',
	1	 'JUN','JUL','AUG','SEP'/
	DATA MONT/'OCTOBER 1  ','NOVEMBER 1 ','DECEMBER 1 ','JANUARY 1  ',
	1	  'FEBRUARY 1 ','MARCH 1    ','APRIL 1    ','MAY 1      ',
	1	  'JUNE 1     ','JULY 1     ','AUGUST 1   ','SEPTEMBER 1'/
	DATA MN/1,2,3,4,5,6,7,8,9,10,11,12/
	DATA PA/'FOJ      ','FOY      ','FJY      ','FDJ      ','FDA      ',
	1       'FJJ      ','FNY      ','FOS      '/
	DATA PC/'FCN      ','FCH      ','FCL      ','FCP      ','FCN      '/
	DATA PND/'60','61','62','63','64','65','66','67'/
	DATA MRK/'E','Y','Y','E','A','E','Y','S'/
C
C
	A='(INCHES)'
	U='(1000AF)'
	F='FORECAST'
	N='NORMAL'
	S='SUBSEQUENT'
	C='CONDITIONS'
	P='PERCENT'
	AP='ABCDEFGHIJKLMNOPQRSTUVWXYZ '
	MARK='            '
C
C
C
C
C
1000	FORMAT(A,1X,A,I1,2A,1X,A,20X,F6.0)
1001	FORMAT(1X,2A,2X,A,10X,4F9.1)
1002	FORMAT(I2)
1006	FORMAT(3H | ,A,4X,A,'-',A,5X,F6.1,5X,F6.1,4X,I4,4X,F6.1,
	1	5X,I4,5X,F6.1,5X,I4,2X,3H  |)
1007	FORMAT(3H | ,103X,2H |,/,2H |,104(1H_),2H_|)
1005	FORMAT(45X,'MONTHLY FORECAST SUMMARY',
	1	/,48X,A,'  ',A,/,2H +,
	1	105(1H-),1H+/,3H | ,23X,1H|,10X,1H|,11X,1H|,5X,A,7X,
	1	1H|,3X,'150% ',A,5X,1H|,3X,'50% ',A,4X,2H |,/
	1	3H | ,23X,1H|,10X,1H|,11X,1H|,3X,A,5X,1H|,3X,A,6X,1H|,
	1	3X,A,4X,2H |/,3H | ,23X,1H|,10X,1H|,11X,'|',
	1	3X,A,5X,1H|,3X,A,6X,1H|,3X,A,4X,2H |,/,
	1	3H | ,23X,1H|,10X,1H|,'1961-1990','  |',18X,1H|,19X,1H|,
	1	17X,2H |/,
	1	3H | ,23X,1H|,A,'  | AVERAGE   |',A,2X,A,' |',A,2X,A,
	1	'  |',A,2X,A,' |'/3H | ,A,15X,'|PERIOD    | ',A,'  |',A,
	1	2X,A,'  |',A,2X,A,3X,1H|,A,2X,A,'  |'/,2H |,105(1H-),1H|,
	1	/,3H | ,103X,2H |/3H | ,39X,'AVE',7X,'NORM',6X,'%',7X,
	1	'HIGH',7X,'%',9X,'LOW',8X,'%',3X,2H |/,3H | ,103X,2H |)
1010	FORMAT(' ERROR IN READ UNIT=1, IOS=',I2,/,A12,6F11.2/12X,F11.2)
1008	FORMAT(' ATTEMPT TO ACCESS NON-EXISTENT RECORD IOS=',I2,1X,A)
1011	FORMAT(' ERROR ON REWRITE IOS=',I2,A12,6F11.2/12X,6F11.2)
1013	FORMAT(' ERROR ON OPEN UNIT=1, IOS=',I2)
1012	FORMAT(' ERROR ON WRITE TO INDEX FILE IOS=',I2,A12,6F11.2/12X,
	16F11.2)
1014	FORMAT(' ERROR ON CLOSE, IOS=',I2,',UNIT=1')
1015	FORMAT(A)
1016	FORMAT(' WRITE FORECASTS TO MPOLL FILE>'$)
1017	FORMAT(' FORECASTS NOT WRITTEN TO MPOLL FILE')
1018	FORMAT(' MPOLL UPDATED!!!!!!')
1019	FORMAT(1H1)
1020	FORMAT(3H | ,A,4X,A,5X,I6,5X,F6.1,4X,I4,3X,2H |,3X,F7.0,4X,2H |)
1021	FORMAT(29X,'MONTHLY FORECAST SUMMARY',/,
	1	32X,A,'  ',A,/,2H +,
	1	82(1H-),1H+ /,
	1	3H | ,23X,1H|,10X,1H|,11X,1H|,5X,A,7X,1H|,14X,2H |/
	1	3H | ,23X,1H|,10X,1H|,11X,1H|,3X,A,5X,1H|,14X,2H |/
	1	3H | ,23X,1H|,10X,1H|,11X,1H|,3X,A,5X,1H|,14X,2H |/
	1       3H | ,23X,1H|,10X,1H|,'1961-1990','  |',18X,1H|,14X,2H |/
	1	3H | ,23X,1H|,A,'  | AVERAGE   |',A,2X,A,' |  BASIN AREA   |',/
	1	3H | ,A,15X,'|PERIOD    | ',A,'  |',A,2X,A,'  | SQUARE MILES  |'/
	1	2H |,82(1H-),1H|/
	1	3H | ,65X,1H|,14X,2H |/
	1	3H | ,39X,'AVE',7X,'NORM',6X,'%',5X,1H|,'     SQ MI     |' /
	1	3H | ,65X,1H|,14X,2H |)
1022	FORMAT(3H | ,65X,1H|,14X,2H |/,2H |,82(1H_),1H|)
1023	FORMAT(53X,'CURRENT')
1024	FORMAT(56X,'MPOLL')
C1025	FORMAT(' READ ',A,/,12X,6F9.2,/,12X,6F9.2)
1026	FORMAT(' REWRITE ',A,/,12X,6F9.2,/,12X,6F9.2)
1027	FORMAT(' WRITE ',A,/,12X,6F9.2,/,12X,6F9.2)
1028	FORMAT(3H | ,A,4X,A,5X,F6.2,5X,F6.2,4X,I4,3X,2H |,3X,F7.0,4X,2H |)
1029	FORMAT(3H | ,A,4X,A,'-',A,5X,F6.2,5X,F6.2,4X,I4,4X,F6.2,
	1	5X,I4,5X,F6.2,5X,I4,2X,3H  |)
1030	FORMAT(50X,'" BASIN INCHES "')
C1030	FORMAT(' MNT=',I2,' ,ADD=',A)
1031    FORMAT(47X,'VOLUME RUNOFF IN KAF')
1032	FORMAT(33X,'" BASIN INCHES "')
1033    FORMAT(31X,'VOLUME RUNOFF IN KAF')
C
C
C
C
C
	I=1
101	READ(2,1000,END=100)TIT(I),CBT(I),ISRR(I),PER(I),PCDA,CBB(I),AREA(I) ! READ FRSTSUM.DAT FILE
	DO 104 IK=1,8
	IF(PCDA.EQ.PND(IK))PCD(I)=PA(IK)
104	CONTINUE
	I=I+1
	GO TO 101
100	K=1
103	READ(3,1001,END=102)P1(K),P2(K),FT(K),FN(K),FH(K),FL(K),FP(K) ! READ DATEJUL.OUT FILE
	K=K+1
	GO TO 103
102	NF=K-1
C
C
C
C
C
	DO 304 J=1,12
	IF(P1(1).EQ.MON(J))THEN
		MONTH=MONT(J)
		MNT=MN(J)
		IF(MNT.GT.9)MNT=10
		END IF
304	CONTINUE
	NT=I-1
C
C
	CALL IDATE(IMO,IDA,IYR)
C	IYR=82
	ENCODE(2,1002,IY)IYR
	if(iyr.ge.80) then
		IYT='19'//IY
	else
		iyt='20'//iy
	end if
	if(iyt(3:3).eq.' ') iyt(3:3)='0'
	DO 300 K=1,NF
	AVE(K)=0.
	DO 301 I=1,NT
	IF(FT(K).EQ.TIT(I))THEN
		CBTT(K)=CBT(I)
		CBTK(K)=CBB(I)
		PCE(K)=PCD(I)
		TPER(K)=PER(I)
		ISRT(K)=ISRR(I)
		END IF
301	CONTINUE
	ADD=CBTK(K)//'       '//'QU       '//'6190'
3000	READ(UNIT=1,KEY=ADD,KEYID=0,IOSTAT=IOS,ERR=2000)ADD,AV
	UNLOCK 1
C
	DO J=1,12
	IF(P1(K) .EQ. MON(J))ISM=MN(J)
	IF(P2(K) .EQ. MON(J))IEM=MN(J)
	ENDDO
	DO J=ISM,IEM
	AVE(K)=AVE(K)+AV(J)
	ENDDO
C
	IPN(K)=(FN(K)/AVE(K)+.005)*100.
	IPH(K)=(FH(K)/AVE(K)+.005)*100.
	IPL(K)=(FL(K)/AVE(K)+.005)*100.
	IFN(K)=FN(K)+.5
	IFH(K)=FH(K)+.5
	IFL(K)=FL(K)+.5
	IAVE(K)=AVE(K)+.5
	GO TO 300
2000	IF(IOS.EQ.52)CALL RECLOCK(*3000,*5000)
	IF(IOS.EQ.36)THEN
		WRITE(6,1008)IOS,ADD
		DO 306 KK=1,12
		AV(KK)=998877.
306		CONTINUE
		END IF
	IAVE(K)=AVE(K)+.5	
300	CONTINUE
C	IF(MNT.GT.9)GO TO 321
	WRITE(7,1019)
	WRITE(7,1023)         ! BEGIN WRITING CURRENT SUMMARY TABLE
	WRITE(7,1005)MONTH,IYT,N,N,N,S,S,S,C,C,C,F,F,P,F,P,F,P,F,U,
	1	     U,N,U,N,U,N
 	DO 305 K=1,NF
	WRITE(7,1006)FT(K),P1(K),P2(K),AVE(K),FN(K),IPN(K),
	1	     FH(K),IPH(K),FL(K),IPL(K)
305	CONTINUE
	WRITE(7,1007)   ! END OF CURRENT SUMMARY TABLE
C
C
321	WRITE(6,1016) ! WRITE FORECASTS TO MPOLL ?
	READ(5,1015)ANS
	IF(ANS.NE.'YES I DO')THEN
		WRITE(6,1017)
		GO TO 5004
		END IF
C
C
C
C
C	WRITE FORECASTS TO INDEX FILE
C**********************************************************************
	DO 307 K=1,NF
	DO 308 JN=1,5
	IF(JN.EQ.5)PC(JN)=PCE(K)
	ADD=CBTT(K)//'       '//PC(JN)//IYT
C	IF(MNT.GT.9.AND.ADD(13:21).NE.'FCP      ')GO TO 308
C	WRITE(6,1030)MNT,ADD
	DO 309 J=1,12
	DATA(J)=998877.
 	MARK(J:J)=' '
309	CONTINUE
3010	READ(UNIT=1,KEY=ADD,KEYID=0,IOSTAT=IOS,ERR=8000)ADD,DATA,MARK
C	WRITE(6,1025)ADD,DATA
	IF(IOS.EQ.0)THEN
	DO 317 KI=1,12
	TT='NO'
	DO 316 JI=1,27
	IF(MARK(KI:KI).EQ.AP(JI:JI))TT='OK'
316	CONTINUE
	IF(TT.EQ.'NO')MARK(KI:KI)=' '
317	CONTINUE
	MARK(MNT:MNT)='T'
	IF(PC(JN).EQ.PCE(K))THEN
		DATA(MNT)=FP(K)
		GO TO 312
		END IF
	IF(PC(JN).EQ.'FCN      ')DATA(MNT)=FN(K)
	IF(PC(JN).EQ.'FCH      ')DATA(MNT)=FH(K)
	IF(PC(JN).EQ.'FCL      ')DATA(MNT)=FL(K)
	IF(PC(JN).EQ.'FCP      ')DATA(MNT)=FP(K)
	DO 311 J=1,7
	IF(PCE(K).EQ.PND(J))THEN
		MARK(MNT:MNT)=MRK(J)
		DO 315 JI=1,12
		IF(MARK(JI:JI).EQ.'H')MARK(JI:JI)=MRK(J)
315		CONTINUE
		END IF
311	CONTINUE
312		REWRITE(UNIT=1,IOSTAT=IOS,ERR=8001)ADD,DATA,MARK
		WRITE(6,1026)ADD,DATA
		WRITE(9,1026)ADD,DATA
		UNLOCK 1
		END IF
	GO TO 308
8000	IF(IOS.EQ.52)CALL RECLOCK(*3010,*5000)
	IF(IOS.EQ.36)THEN	
		MARK(MNT:MNT)='T'
		IF(PC(JN).EQ.PCE(K))THEN
			DATA(MNT)=FP(K)
			GO TO 313
			END IF
		IF(PC(JN).EQ.'FCN      ')DATA(MNT)=FN(K)
		IF(PC(JN).EQ.'FCH      ')DATA(MNT)=FH(K)
		IF(PC(JN).EQ.'FCL      ')DATA(MNT)=FL(K)
		IF(PC(JN).EQ.'FCP      ')DATA(MNT)=FP(K)
		DO 314 J=1,7
		IF(PCE(K).EQ.PND(J))MARK(MNT:MNT)=MRK(J)
314		CONTINUE
313		WRITE(UNIT=1,IOSTAT=IOS,ERR=5001)ADD,DATA,MARK
		WRITE(6,1027)ADD,DATA
		WRITE(9,1027)ADD,DATA
		UNLOCK 1
		GO TO 308
		END IF
	WRITE(6,1010)IOS,ADD,DATA
	GO TO 5000
308	CONTINUE
307	CONTINUE
	WRITE(6,1018)
C
C
C	END OF WRITE TO INDEX FILE
C***********************************************************************
C
C
C       BEGIN TO WRITE FORECASTS FROM MPOLL FILE.   THE BASIN INCHES TABLES ARE COMPLETED HERE  
C
	IF(MNT.GT.9)GO TO 5000
5004	WRITE(7,1019)
	WRITE(7,1031)
	WRITE(7,1024)
	WRITE(7,1005)MONTH,IYT,N,N,N,S,S,S,C,C,C,F,F,P,F,P,F,P,F,U,
	1	     U,N,U,N,U,N
	WRITE(8,1019)
	WRITE(8,1033)
	WRITE(8,1021)MONTH,IYT,N,S,C,F,F,P,F,U,U,N
	WRITE(11,1019)
	WRITE(11,1030)
	WRITE(11,1024)
	WRITE(11,1005)MONTH,IYT,N,N,N,S,S,S,C,C,C,F,F,P,F,P,F,P,F,A,
	1	     A,N,A,N,A,N
	WRITE(10,1019)
	WRITE(10,1032)
	WRITE(10,1021)MONTH,IYT,N,S,C,F,F,P,F,A,A,N
C
C
	IF(MNT.EQ.4)PMN='JAN'
	IF(MNT.EQ.5)PMN='FEB'
	IF(MNT.EQ.6)PMN='MAR'
	IF(MNT.EQ.7)PMN='APR'
	IF(MNT.EQ.8)PMN='MAY'
	IF(MNT.EQ.9)PMN='JUN'
C
C
	DO 318 I=1,NT
	JAVE(I)=0.
	AVE(I)=0.
	DO 319 JN=1,4
	ADD=CBT(I)//'       '//PC(JN)//IYT
3011	READ(UNIT=1,KEY=ADD,KEYID=0,IOSTAT=IOS,ERR=8002)ADD,DATA,MARK
	UNLOCK 1
 	IF(JN.EQ.1)FN(I)=DATA(MNT)
	IF(JN.EQ.2)FH(I)=DATA(MNT)
	IF(JN.EQ.3)FL(I)=DATA(MNT)
	IF(JN.EQ.4)FP(I)=DATA(MNT)
319	CONTINUE
C
	IF(FN(I) .EQ. 998877.)GO TO 318
C
	ADD=CBB(I)//'       '//'QU       '//'6190'
	ISW=0
3012	READ(UNIT=1,KEY=ADD,KEYID=0,IOSTAT=IOS,ERR=8003)ADD,DATA,MARK
	UNLOCK 1
C
	DO J=1,12
	IF(PMN .EQ. MON(J))ISM=MN(J)
	IF(PER(I)(5:7) .EQ. MON(J))IEM=MN(J)
	ENDDO
	DO J=ISRR(I),IEM
	DAVE(I)=DAVE(I)+DATA(J)
	ENDDO
	JAVE(I)=DAVE(I)+.5
	DO J=ISM,IEM
	AVE(I)=AVE(I)+DATA(J)
	END DO
C
	IPN(I)=(FN(I)/AVE(I)+.005)*100.
	IPH(I)=(FH(I)/AVE(I)+.005)*100.
	IPL(I)=(FL(I)/AVE(I)+.005)*100.
	IFP(I)=(FP(I)/JAVE(I)+.005)*100.
C
C	JAVE(I)=DATA(ISRR(I))+.5
	AJV=DATA(ISRR(I))/AREA(I)*18.75
C	AVE(I)=DATA(MNT)
	AFN=FN(I)/AREA(I)*18.75
	AFH=FH(I)/AREA(I)*18.75
	AFL=FL(I)/AREA(I)*18.75
	AFP=FP(I)/AREA(I)*18.75
	AAVE=AVE(I)/AREA(I)*18.75
	WRITE(7,1006)TIT(I),PMN,PER(I)(5:7),AVE(I),FN(I),IPN(I),
	1	     FH(I),IPH(I),FL(I),IPL(I)
	WRITE(8,1020)TIT(I),PER(I),JAVE(I),FP(I),IFP(I),AREA(I)
	WRITE(11,1029)TIT(I),PMN,PER(I)(5:7),AAVE,AFN,IPN(I),
	1	     AFH,IPH(I),AFL,IPL(I)
	WRITE(10,1028)TIT(I),PER(I),AJV,AFP,IFP(I),AREA(I)
	GO TO 318
8002	IF(IOS.EQ.52)CALL RECLOCK(*3011,*5000)
	IF(IOS.EQ.36)WRITE(6,1008)IOS,ADD
	GO TO 318
8003	IF(IOS.EQ.52)CALL RECLOCK(*3012,*5000)
	ADD=CBB(I)//ADD(6:25)
	ISW=ISW+1
	IF(ISW.GT.1)GO TO 320
	GO TO 3012
320	IF(IOS.EQ.36)WRITE(6,1008)IOS,ADD
318	CONTINUE
	WRITE(7,1007)
C	WRITE(7,1019)
	WRITE(8,1022)
	WRITE(11,1007)
	WRITE(11,1019)
	WRITE(10,1022)
	GO TO 5000
C
C
C
C
C **** ERROR ROUTING *******************************************************************************************************      
C
8001	WRITE(6,1012)IOS,ADD,DATA
	GO TO 5000
5001	WRITE(6,1012)IOS,ADD,DATA
	GO TO 5000
9999	WRITE(6,1013)IOS
	GO TO 5003
5000	CLOSE(UNIT=1,ERR=5002,IOSTAT=IOS)
	GO TO 5003
5002	WRITE(6,1014)IOS
	GO TO 5003
5003	STOP
	END
